#!/usr/bin/perl -w

use strict;

my $range = $ARGV[0] || 12+11;

my %g_max_consecutive_intervals = (1 => 1, 2 => 3, 3 => 1);
my $g_max_interval = 2;

my $n_max_attempts = 20;

# "gsp" variables: state variables used in should_print().
my $gsp_c_printed_scales = 0;
my $gsp_c_attempted_scales = 0;
my %gsp_min_score = ('white_keys' => 1, 'octaves' => 1);
my %gsp_seen_scale;
my %gsp_seen_intervals;

while ( $gsp_c_printed_scales < $n_max_attempts and $gsp_c_attempted_scales < 10000 )
{
    my @scale = &random_scale($range);
    my %score;
    ($score{'white_keys'}, $score{'transposition'}) = &score_white_keys(@scale);
    $score{'octaves'} = &score_octaves(@scale);

    next unless &should_print(\%score, \@scale);

    @scale = map { ($_+$score{'transposition'}) } @scale;
    my @major_scale_anchors = &major_scale_anchors(@scale);

    ++$gsp_c_printed_scales;
    printf '%2d %3d %2.3f %2.3f %s [%s]%s',
    $gsp_c_printed_scales,
    $gsp_c_attempted_scales,
    $score{'white_keys'},
    $score{'octaves'},

    join(' ', map { $_%12} @scale),
    join(', ', map { $scale[$_] } @major_scale_anchors),

    "\n";
}

exit;

sub should_print
{
    my ($hr_score, $ar_scale) = @_;
    my %score = %{$hr_score};
    my @scale = @{$ar_scale};

    ++$gsp_c_attempted_scales;

    return 0 if $gsp_seen_scale{join ':', @scale}++;
    my @these_seen_intervals;
    for my $i (0..$#scale)
    {
	my @intervals = map { ($scale[($i+$_+1)%@scale] - $scale[($i+$_)%@scale]) % 12 } (0..$#scale);
	#warn join ' ', 'scale', @scale, ': ', 'intervals', @intervals;
	my $intervals = join ' ', @intervals;
	return 0 if $gsp_seen_intervals{$intervals};
	push @these_seen_intervals, $intervals;
    }
    map { $gsp_seen_intervals{$_}++ } @these_seen_intervals;
    #die;

    return 0 unless $score{'white_keys'} <= $gsp_min_score{'white_keys'};
    $gsp_min_score{'white_keys'} = $score{'white_keys'};

#    if ( $score{'white_keys'} < $gsp_min_score{'white_keys'} )
#    {
#	$gsp_min_score{'octaves'} = 1;
#    }
#
#    $gsp_min_score{'octaves'} = $score{'octaves'};

    return 1; # for now.

#    next unless $score{'white_keys'} < $gsp_min_score{'white_keys'} or $gsp_c_printed_scales < $n_max_attempts/2;
}

sub random_scale
{
    my ($range) = @_;
    $range ||= 12;
    my @s = (0);
    while ( $s[$#s]-$s[0] <= $range )
    {
	# Max consecutive intervals.
	my @forbidden_intervals = ();
	if ( scalar(@s) > 1 )
	{
	    my $prev_interval = $s[$#s] - $s[$#s-1];
	    if ( $s[$#s]-$s[$#s-$g_max_consecutive_intervals{$prev_interval}] == $g_max_consecutive_intervals{$prev_interval}*$prev_interval )
	    {
		push @forbidden_intervals, $s[$#s]-$s[$#s-1];
	    }
	}
	my $step_size;
	while ( 1 )
	{
	    $step_size = 1 + int(rand $g_max_interval);
	    next if grep { $step_size eq $_ } @forbidden_intervals;
	    last;
	}
	push @s, $s[$#s] + $step_size;
    }
    pop @s;
    return @s;
}

sub score_white_keys
# Give a score telling how well a sequence of notes can be fit to the white keys.
{
    my @scale = @_;

    my @scores = ();
    for my $transposition (0..11)
    {
	push @scores, &score_white_keys_literal(map { ($_ + $transposition)%12 } @scale);
    }
    my $i_max = 0;
    map { $i_max = $_ if $scores[$_] > $scores[$i_max] } (1..$#scores);
    return ($scores[$i_max], $i_max) if wantarray;
    return $scores[$i_max];
}

sub score_white_keys_literal
{
    my @scale = @_;
    my @white_keys = qw(0 2 4 5 7 9 11);

    my ($white, $black) = (0, 0);
    for ( @scale )
    {
	my $note = $_ % 12;
	if ( grep { $note eq $_ } @white_keys )
	{
	    ++$white;
	}
	else
	{
	    ++$black;
	}
    }
    return $white/($white+$black);
}

sub score_octaves
{
    my @scale = @_;
    my %seen = ();
    my ($c_octaves, $c_total) = (0, 0);
    for (@scale)
    {
	++$c_total;
	++$c_octaves if $seen{$_ % 12}++;
    }
    return 2*$c_octaves/$c_total;
}

sub major_scale_anchors
{
    my @scale = @_;
    my @major_scale_interval = qw(0 2 4 5 7 9 11 12);
    my @major_scale_interval_backwards = qw(0 1 3 5 7 8 10 12);
    my @length_major_scale_from;
  SCALE_START:
    for my $i (0..$#scale-1)
    {
	$length_major_scale_from[$i] = 0;
      SCALE_END:
	for my $j ($i+1..$#scale)
	{
	    #die join(':', @scale) . "; $i, $j" if $j-$i > $#major_scale_interval;
	    last SCALE_END if $j-$i > $#major_scale_interval;
	    #warn "($scale[$j] - $scale[$i]) == $major_scale_interval[$j-$i]";
	    last SCALE_END unless ($scale[$j] - $scale[$i]) == $major_scale_interval[$j-$i];
	    ++$length_major_scale_from[$i];
	}
      SCALE_END_BACKWARDS:
	for my $j (reverse(0..$i-1))
	{
	    last SCALE_END_BACKWARDS if $i-$j > $#major_scale_interval_backwards;
	    #warn "[$i, $j] ($scale[$i] - $scale[$j]) == $major_scale_interval_backwards[$i-$j]";
	    last SCALE_END_BACKWARDS unless ($scale[$i] - $scale[$j]) == $major_scale_interval_backwards[$i-$j];
	    $length_major_scale_from[$i] += 0.5;
	}
    }
    #print "scale: ", join(' ', @scale), "\n";
    #print "length_major_scale_from: ", join(' ', @length_major_scale_from), "\n";
    #exit;
    return 
      sort { $length_major_scale_from[$b] <=> $length_major_scale_from[$a] or $a <=> $b } 
	grep { $length_major_scale_from[$_] >= 3 }
	  (0..$#length_major_scale_from);
}